;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; This file is part of rehash.
;;;
;;; rehash is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; rehash is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with rehash.  If not, see <http://www.gnu.org/licenses/>.

;; Synopsis: control a download (locations, progress, ...)
;; TODO: actual subdownload and sidedownload
;; TODO: implement missing parts
;; TODO: more TODO
(define-library (remirror download-manager)
  (export download-context?
	  make-download-context/hash
	  make-download-context/nar
	  make-download-context/url
	  suggest-urls!
	  start-download-fiber!
	  stop-download-fiber!)
  (import (only (guile) define-once
		make-guardian
		hook->list
		after-gc-hook
		add-hook!)
	  (rnrs base)
	  (rnrs records syntactic)
	  (ice-9 match))
  (begin
    ;; define-once: in case this module is reloaded
    ;;
    ;; TODO maybe use this mechanism
    ;; (in a generalised form for other resources
    ;; as well)
    (define-once %download-guardian (make-guardian))
    (define-once (stop-forgotten-downloads)
      (let ((x (%download-guardian)))
	(when x
	  (stop-context-fiber! x)
	  (stop-forgotten-downloads))))

    (unless (memq stop-forgotten-downloads (hook->list after-gc-hook))
      (add-hook! after-gc-hook stop-forgotten-downloads))

    ;; why the external/internal split:
    ;;  otherwise the fiber would keep the context reachable,
    ;;  and stop-forgotten-downloads wouldn't be able
    ;;  to stop anything
    ;;
    ;; (The fiber uses the internal context, and code from other
    ;; modules call the external context, which has a reference
    ;; to the internal context.)
    (define-record-type (download/external %make-download/external
					   download-context?)
      (fields (immutable internal download-internal))
      (sealed #t)
      (opaque #t)
      ;; for when reloading
      (nongenerative remirror:download/external))

    (define-record-type (download/internal %make-download/internal
					   download-context?)
      (fields (immutable stop-condition stop-condition)
	      (immutable channel channel)
	      (mutable nar-components nar-components
		       set-nar-components!)
	      (mutable known-urls known-urls set-known-urls!) ;; <-- 404 is OK
	      (mutable known-hashes known-hashes set-known-hashes!)
	      (mutable suspicous-hashes suspicious-hashes))
      (sealed #t)
      (opaque #t)
      ;; for when reloading
      (nongenerative remirror:download/internal))

    (define (%make-download/empty)
      (%make-download/external (%make-download/internal
				(make-condition)
				(make-channel)
				'()
				'()
				'())))

    (define (make-download-context/hash hash)
      (assert (hash? hash))
      (let ((e (%make-download/empty)))
	(set-known-hashes! e (list hash))
	e))

    (define (make-download-context/nar . components)
      (let ((e (%make-download/empty)))
	(set-nar-components! e components)
	e))

    (define (make-download-context/url url)
      (assert (string? url))
      (let ((e (%make-download/empty)))
	(set-known-urls! e url)
	e))

    (define (download/internal-loop internal)
      (let* ((op/stop (wait-operation (stop-condition internal)))
	     (op/msg  (get-operation (channel internal)))
	     (op (choice-operation
		  (wrap-operation wait-operation
				  (lambda () 'close)))
		 op/msg))
	(match (perform-operation op)
	  ('close (values))
	  (`(suggest-urls! . ,@extra)
	   (let* ((old (known-urls internal))
		  (new (lset-union string=? old extra)))
	     ;; FIXME wake up URL method
	     (set-known-urls! internal new)))
	  ('??? ???))))

    (define (suggest-urls! ctx . urls)
      (for-each (lambda (url)
		  (assert (string? url))) urls)
      (let ((internal (download-internal ctx)))
	(perform-operation
	 (choice-operation
	  (put-operation (channel internal)
			 `(suggest-urls! ,@urls))
	  (wait-operation (stop-condition internal))))))


    ;; FIXME prevent starting multiple times
    (define (start-context-fiber! ctx)
      (let ((internal (download-internal ctx)))
	;; FIXME exceptions
	(spawn-fiber (lambda () (download/internal-loop internal)))))

    (define (stop-context-fiber! ctx)
      (signal-condition (stop-condition (download-internal ctx))))))
